CLEAR ,65000
Main:

DIM bPlane&(5),cTabWork%(32),cTabSave%(32),scolor!(31,3),box%(6568),piece%(203,49),s$(49)

ccrtDir%   = 0
ccrtStart% = 0
ccrtEnd%   = 0
ccrtSecs&  = 0
ccrtMics&  = 0
DECLARE FUNCTION xOpen&  LIBRARY
DECLARE FUNCTION xRead&  LIBRARY
DECLARE FUNCTION xWrite& LIBRARY
DECLARE FUNCTION AllocMem&() LIBRARY
LIBRARY "dos.library"
LIBRARY "exec.library"
LIBRARY "graphics.library"
CLS:PRINT TAB(20);"PUZZLE MAKER v1.0 (c)1987 Oston Software"
PRINT:PRINT TAB(28);"Written by Syd L. Bolton"
PRINT:PRINT:PRINT "Please read 'PUZZLE.MAKER.doc' for program info and complete instructions.":PRINT 
GetNames:
INPUT "   IFF ILBM filespec";ILBMname$
IF (ILBMname$ = "") GOTO Mcleanup2
loadError$ = ""
GOSUB LoadILBM
IF loadError$ <> "" THEN Mcleanup
IF (loadError$ = "") THEN SavePuzzle
Mcleanup:
WINDOW CLOSE 2
SCREEN CLOSE 2
Mcleanup2:
LIBRARY CLOSE
IF loadError$ <> "" THEN PRINT loadError$
END
LoadILBM:
f$="df0:"+ILBMname$
fHandle& = 0
mybuf& = 0
foundBMHD = 0
foundCMAP = 0
foundCAMG = 0
foundCCRT = 0
foundBODY = 0
filename$ = f$ + CHR$(0)
fHandle& = xOpen&(SADD(filename$),1005)
IF fHandle& = 0 THEN
   loadError$ = "Can't open/find pic file"
   GOTO Lcleanup
END IF

ClearPublic& = 65537
mybufsize& = 360
mybuf& = AllocMem&(mybufsize&,ClearPublic&)
IF mybuf& = 0 THEN
   loadError$ = "Can't alloc buffer"
   GOTO Lcleanup
END IF
inbuf& = mybuf&
cbuf& = mybuf& + 120
ctab& = mybuf& + 240
rLen& = xRead&(fHandle&,inbuf&,12)
tt$ = ""
FOR kk = 8 TO 11
   tt% = PEEK(inbuf& + kk)
   tt$ = tt$ + CHR$(tt%)
NEXT
IF tt$ <> "ILBM" THEN 
   loadError$ = "Not standard ILBM pic file"
   GOTO Lcleanup
END IF
ChunkLoop:
 rLen& = xRead&(fHandle&,inbuf&,8)
 icLen& = PEEKL(inbuf& + 4)
 tt$ = ""
 FOR kk = 0 TO 3
    tt% = PEEK(inbuf& + kk)
    tt$ = tt$ + CHR$(tt%)
 NEXT       
IF tt$ = "BMHD" THEN
   foundBMHD = 1
   rLen& = xRead&(fHandle&,inbuf&,icLen&)
   iWidth%  = PEEKW(inbuf&)
   iHeight% = PEEKW(inbuf& + 2)
   iDepth%  = PEEK(inbuf& + 8)  
   iCompr%  = PEEK(inbuf& + 10)
   scrWidth%  = PEEKW(inbuf& + 16)
   scrHeight% = PEEKW(inbuf& + 18)
   iRowBytes% = iWidth% /8
   scrRowBytes% = scrWidth% / 8
   nColors%  = 2^(iDepth%)
   IF scrWidth%<>320 OR scrHeight%<>200 OR nColors%<>32 THEN loadError$="Must be 320X200 5 bit-plane image.":GOTO Lcleanup   
   AvailRam& = FRE(-1)
   NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
   IF AvailRam& < NeededRam& THEN
      loadError$ = "Not enough free ram"
      GOTO Lcleanup
   END IF
   kk = 1
   IF scrWidth% > 320 THEN kk = kk + 1
   IF scrHeight% > 200  THEN kk = kk + 2
   SCREEN 2,scrWidth%,scrHeight%,iDepth%,kk
   WINDOW 2,"Puzzle Maker",,7,2
   LINE (0,0)-(200,100),,bf:GET (0,0)-(200,100),box%
   CLS
   GOSUB GetScrAddrs
ELSEIF tt$ = "CMAP" THEN
   foundCMAP = 1
   rLen& = xRead&(fHandle&,cbuf&,icLen&)
   FOR kk = 0 TO nColors% - 1
      red% = PEEK(cbuf&+(kk*3))
      gre% = PEEK(cbuf&+(kk*3)+1)
      blu% = PEEK(cbuf&+(kk*3)+2)
      regTemp% = (red%*16)+(gre%)+(blu%/16)
      scolor!(kk,1)=red%/255:scolor!(kk,2)=gre%/255:scolor!(kk,3)=blu%/255
      POKEW(ctab&+(2*kk)),regTemp%
   NEXT
ELSEIF tt$ = "CAMG" THEN
   foundCAMG = 1
   rLen& = xRead&(fHandle&,inbuf&,icLen&)
   camgModes& = PEEKL(inbuf&)
ELSEIF tt$ = "CCRT" THEN
   foundCCRT = 1
   rLen& = xRead&(fHandle&,inbuf&,icLen&)
   ccrtDir%    = PEEKW(inbuf&)
   ccrtStart%  = PEEK(inbuf& + 2)
   ccrtEnd%    = PEEK(inbuf& + 3)
   ccrtSecs&   = PEEKL(inbuf& + 4)
   ccrtMics&   = PEEKL(inbuf& + 8)
ELSEIF tt$ = "BODY" THEN 
   foundBODY = 1 
   IF iCompr% = 0 THEN
      FOR rr = 0 TO iHeight% -1
         FOR pp = 0 TO iDepth% -1
            scrRow& = bPlane&(pp)+(rr*scrRowBytes%)
            rLen& = xRead&(fHandle&,scrRow&,iRowBytes%)   
         NEXT
      NEXT
   ELSEIF iCompr% = 1 THEN
FOR rr = 0 TO iHeight% -1
FOR pp = 0 TO iDepth% -1
scrRow& = bPlane&(pp)+(rr*scrRowBytes%)
bCnt% = 0            
WHILE (bCnt% < iRowBytes%)
rLen& = xRead&(fHandle&,inbuf&,1)
inCode% = PEEK(inbuf&)
IF inCode% < 128 THEN
rLen& = xRead&(fHandle&,scrRow& + bCnt%, inCode%+1)
bCnt% = bCnt% + inCode% + 1
ELSEIF inCode% > 128 THEN
rLen& = xRead&(fHandle&,inbuf&,1)   
inByte% = PEEK(inbuf&)
FOR kk = bCnt% TO bCnt% + 257 - inCode%
POKE(scrRow&+kk),inByte%
NEXT   
bCnt% = bCnt% + 257 - inCode%
END IF
WEND
NEXT
NEXT         
   ELSE
      loadError$ = "Unknown compression algorithm"
      GOTO Lcleanup
   END IF
ELSE 
   FOR kk = 1 TO icLen&
      rLen& = xRead&(fHandle&,inbuf&,1)
   NEXT
   IF (icLen& OR 1) = icLen& THEN 
      rLen& = xRead&(fHandle&,inbuf&,1)
   END IF      
END IF
IF foundBMHD AND foundCMAP AND foundBODY THEN
   GOTO GoodLoad
END IF
IF rLen&> 0 THEN GOTO ChunkLoop
IF rLen& < 0 THEN 
   loadError$ = "Read error"
   GOTO Lcleanup
END IF   
IF (foundBMHD=0) OR (foundBODY=0) OR (foundCMAP=0) THEN
   loadError$ = "Needed ILBM chunks not found"
   GOTO Lcleanup
END IF
GoodLoad:
loadError$ = ""
IF foundCMAP THEN 
   CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
END IF
Lcleanup:
IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
RETURN
SavePuzzle:
zz=MOUSE(0)
WHILE MOUSE(0)=0:WEND
x=MOUSE(1):y=MOUSE(2)
PUT (x,y),box%
WHILE MOUSE(0)<0
  x1=MOUSE(1):y1=MOUSE(2)
  IF (x1<>x OR y1<>y) AND x1<117 AND y1<88 THEN PUT (x,y),box%:PUT (x1,y1),box%:x=x1:y=y1
WEND
PUT (x1,y1),box%
FOR c=0 TO 4
FOR r=0 TO 9
GET (x1+r*20,y1+c*20)-(x1+r*20+19,y1+c*20+19),piece%(0,c*10+r)
NEXT
NEXT
WINDOW CLOSE 2
SCREEN CLOSE 2
WINDOW OUTPUT 1
CLS
PRINT "Please wait..."
FOR i=0 TO 49
  FOR j=3 TO 202
    s$(i)=s$(i)+MKI$(piece%(j,i))
  NEXT
NEXT
INPUT "Puzzle filename";f$
f$="df0:"+f$+".pzl"
OPEN f$ FOR OUTPUT AS #1
PRINT#1,"BPFF"
FOR i=0 TO 31
  PRINT#1,scolor!(i,1),scolor!(i,2),scolor!(i,3)
NEXT
FOR i=0 TO 49
  PRINT#1,s$(i);
NEXT
FOR i=0 TO 49
  FOR j=0 TO 203
    PRINT#1,MKI$(piece%(j,i));
  NEXT
NEXT
PRINT#1,"0"
CLOSE #1
KILL f$+".info"
PRINT "Puzzle ready to play.":END
GetScrAddrs:
   sWindow&   = WINDOW(7)
   sScreen&   = PEEKL(sWindow& + 46)
   sViewPort& = sScreen& + 44
   sRastPort& = sScreen& + 84
   sColorMap& = PEEKL(sViewPort& + 4)
   colorTab&  = PEEKL(sColorMap& + 4)
   sBitMap&   = PEEKL(sRastPort& + 4)
   scrWidth%  = PEEKW(sScreen& + 12)
   scrHeight% = PEEKW(sScreen& + 14)
   scrDepth%  = PEEK(sBitMap& + 5)
   nColors%   = 2^scrDepth%
   FOR kk = 0 TO scrDepth% - 1
      bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
   NEXT
RETURN